home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok31.lha / Thermic / Therm.mod < prev    next >
Text File  |  1993-08-15  |  8KB  |  237 lines
  1. (*---------------------------------------------------------------------------
  2.    :Program.    Thermic
  3.    :Contants.   Simulation von Wärmeausbreitung
  4.    :Remark.     very simple
  5.    :Author.     Markus Peuckert
  6.    :Address.    Schützenstr. 50, D-3550 Marburg, West-Germany,
  7.    :History.    V1.0, Markus Peuckert, Oct-89
  8.    :Copyright.  PD
  9.    :Language.   Modula-2
  10.    :Translator. M2Amiga V3.2d
  11. ---------------------------------------------------------------------------*)
  12.  
  13. MODULE Therm;
  14.  
  15. FROM SYSTEM     IMPORT  INLINE, ADR, ADDRESS;
  16. FROM Arts       IMPORT  Assert, TermProcedure, CurrentLevel, BreakPoint;
  17. FROM Intuition  IMPORT  ScreenPtr, WindowPtr, WindowFlags, WindowFlagSet,
  18.                         ScreenFlags, ScreenFlagSet, customScreen, RemakeDisplay,
  19.                         SetPointer, IDCMPFlagSet, IDCMPFlags, CloseWindow,
  20.                         CloseScreen, NewScreen,NewWindow,OpenScreen,
  21.                         OpenWindow;
  22. FROM Graphics   IMPORT  ViewModes, ViewModeSet, LoadRGB4, ViewPortPtr,
  23.                         RastPortPtr, SetAPen, RectFill, Move, WritePixel;
  24. FROM Exec       IMPORT  WaitPort;
  25.  
  26.  
  27. CONST   WIDTH   = 320;
  28.         HEIGHT  = 256;
  29.         DEPTH   = 5;
  30.  
  31.         MaxSeg  = 50;
  32.  
  33. TYPE    Segment =       RECORD
  34.                                 Temp,
  35.                                 Farbe,
  36.                                 x, y,
  37.                                 dx, dy          : INTEGER;
  38.                                 reserved        : BOOLEAN;
  39.                         END;
  40.         StangTyp=       ARRAY [0..MaxSeg], [0..MaxSeg] OF Segment;
  41.  
  42. VAR     Level           : INTEGER;
  43.         scr             : ScreenPtr;
  44.         win             : WindowPtr;
  45.         rp              : RastPortPtr;
  46.         vp              : ViewPortPtr;
  47.  
  48.         Stange          : StangTyp;
  49.  
  50.  
  51. PROCEDURE CreateScreen (w,h,d : INTEGER; vm : ViewModeSet; t,gad : ADDRESS)
  52.                                                                  : ScreenPtr;
  53. VAR ns  : NewScreen;
  54.     scr : ScreenPtr;
  55. BEGIN
  56.  WITH ns DO
  57.   leftEdge:=0; topEdge:=0; width:=w; height:=h; depth:=d; detailPen:=0;
  58.   blockPen:=1; viewModes:=vm; type:=customScreen;font:=NIL; defaultTitle:=t;
  59.   gadgets:=gad; customBitMap:=NIL
  60.  END;
  61.  scr := OpenScreen (ns);
  62.  Assert (scr#NIL, ADR("Kein Schirm"));
  63.  RETURN scr
  64. END CreateScreen;
  65.  
  66. PROCEDURE CreateWindow(x,y,w,h : INTEGER; if: IDCMPFlagSet; wf: WindowFlagSet;
  67.                        gad,scr,tit : ADDRESS; typ : ScreenFlagSet) : WindowPtr;
  68. VAR
  69.  nw  : NewWindow;
  70.  win : WindowPtr;
  71. BEGIN
  72.  WITH nw DO
  73.   leftEdge:=x; topEdge:=y; width:=w; height:=h; detailPen:=0; blockPen:=1;
  74.   idcmpFlags:=if; flags:=wf; firstGadget:=gad; checkMark:=NIL; title:=tit;
  75.   screen:=scr; bitMap:=NIL; minWidth:=160; minHeight:=14; maxWidth:=w;
  76.   maxHeight:=h; type:=typ
  77.  END;
  78.  win := OpenWindow(nw);
  79.  Assert (win#NIL, ADR("Kein Fenster"));
  80.  RETURN win
  81. END CreateWindow;
  82.  
  83. PROCEDURE FarbTest;
  84. VAR i : INTEGER;
  85. BEGIN
  86.  FOR i:=0 TO 31 DO
  87.   SetAPen (rp, i);
  88.   RectFill (rp, 40+i*5, 0, 45+i*5, 10);
  89.  END
  90. END FarbTest;
  91.  
  92. PROCEDURE Zeichne (SegX, SegY : INTEGER);
  93. VAR err : INTEGER;
  94. BEGIN
  95.   WITH Stange[SegX][SegY] DO
  96.    SetAPen (rp, Farbe);
  97.    RectFill (rp, x, y, dx, dy);
  98.   END
  99. END Zeichne;
  100.  
  101. PROCEDURE Process;
  102. CONST   MaxTemp                 = 1000;
  103. VAR     a, xx, yy,
  104.         FarbFak, TempHelp       : INTEGER;
  105. BEGIN
  106.  Stange [0][0].Temp := MaxTemp;  Stange[0][0].Farbe := 31;
  107.  Stange[0][0].reserved := TRUE;  Zeichne (0,0);
  108.  
  109.  Stange [35][30].Temp := MaxTemp;  Stange[35][30].Farbe := 31;
  110.  Stange [35][30].reserved := TRUE; Zeichne (35,30);
  111.  
  112.  Stange [10][30].Temp := MaxTemp;  Stange[10][30].Farbe := 31;
  113.  Stange [10][30].reserved := TRUE; Zeichne (10,30);
  114.  
  115.  Stange [30][27].Temp := MaxTemp;  Stange[30][27].Farbe := 31;
  116.  Stange [30][27].reserved := TRUE; Zeichne (30,27);
  117.  
  118.  Stange [25][15].Temp := MaxTemp;  Stange[25][15].Farbe := 31;
  119.  Stange [25][15].reserved := TRUE; Zeichne (25,15);
  120.  
  121.  FarbFak := Stange[0][0].Temp DIV 31;
  122.  
  123.  FOR a:=0 TO 500 DO
  124.   FOR yy:=0 TO MaxSeg DO
  125.    FOR xx:=0 TO MaxSeg DO
  126.  
  127.     IF NOT Stange[xx][yy].reserved THEN
  128.      TempHelp := Stange[xx][yy].Temp;
  129.      IF ((xx>0) AND (yy>0) AND (xx<MaxSeg) AND (yy<MaxSeg)) THEN
  130.        Stange [xx][yy].Temp :=
  131.          (Stange[xx-1][yy].Temp + Stange[xx+1][yy].Temp +
  132.          Stange[xx][yy-1].Temp + Stange[xx][yy+1].Temp +
  133.          Stange[xx-1][yy-1].Temp + Stange[xx-1][yy+1].Temp +
  134.          Stange[xx+1][yy-1].Temp + Stange[xx+1][yy+1].Temp) DIV 8;
  135.      ELSIF ((xx=0) AND (yy>0) AND (yy<MaxSeg)) THEN
  136.       Stange [xx][yy].Temp :=
  137.         (Stange[xx+1][yy].Temp + Stange[xx][yy-1].Temp + Stange[xx][yy+1].Temp +
  138.          Stange[xx+1][yy-1].Temp + Stange[xx+1][yy+1].Temp) DIV 5;
  139.      ELSIF ((xx>0) AND (xx<MaxSeg) AND (yy=0)) THEN
  140.       Stange [xx][yy].Temp :=
  141.         (Stange[xx+1][yy].Temp + Stange[xx-1][yy].Temp + Stange[xx][yy+1].Temp+
  142.          Stange[xx-1][yy+1].Temp + Stange[xx+1][yy+1].Temp) DIV 5;
  143.      ELSIF ((xx>0) AND (xx<MaxSeg) AND (yy=MaxSeg)) THEN
  144.       Stange [xx][yy].Temp :=
  145.         (Stange[xx+1][yy].Temp + Stange[xx-1][yy].Temp + Stange[xx][yy-1].Temp +
  146.          Stange[xx-1][yy-1].Temp + Stange[xx+1][yy-1].Temp) DIV 5;
  147.      ELSIF ((xx=MaxSeg) AND (yy>0) AND (yy<MaxSeg)) THEN
  148.       Stange [xx][yy].Temp :=
  149.         (Stange[xx][yy-1].Temp + Stange[xx][yy+1].Temp + Stange[xx-1][yy].Temp +
  150.          Stange[xx-1][yy-1].Temp + Stange[xx-1][yy+1].Temp) DIV 5;
  151.      ELSIF ((xx=MaxSeg) AND (yy=0)) THEN
  152.       Stange [xx][yy].Temp :=
  153.         (Stange[xx][yy+1].Temp + Stange[xx-1][yy].Temp +
  154.         Stange[xx-1][yy+1].Temp) DIV 3;
  155.      ELSIF ((xx=MaxSeg) AND (yy=MaxSeg)) THEN
  156.       Stange [xx][yy].Temp :=
  157.         (Stange[xx][yy-1].Temp + Stange[xx-1][yy].Temp +
  158.         Stange[xx-1][yy-1].Temp) DIV 3;
  159.      ELSIF ((xx=0) AND (yy=MaxSeg)) THEN
  160.       Stange [xx][yy].Temp :=
  161.         (Stange[xx][yy-1].Temp + Stange[xx+1][yy].Temp +
  162.         Stange[xx+1][yy-1].Temp) DIV 3;
  163.      END;
  164.      IF (TempHelp # Stange[xx][yy].Temp) THEN
  165.       Stange [xx][yy].Farbe := Stange [xx][yy].Temp DIV FarbFak;
  166.       IF Stange[xx][yy].Farbe = 0 THEN Stange[xx][yy].Farbe := 1 END;
  167.       Zeichne (xx, yy)
  168.      END (* if *)
  169.     ELSE
  170.     END (* if *)
  171.    END (* xx *)
  172.   END (* yy *)
  173.  END (* a *)
  174. END Process;
  175.  
  176. PROCEDURE SegInit;
  177. VAR xx, yy : INTEGER;
  178. BEGIN
  179.  FOR yy:=0 TO MaxSeg DO
  180.   FOR xx:=0 TO MaxSeg DO
  181.    WITH Stange[xx][yy] DO
  182.     Temp := 0;  Farbe := 1;  reserved := FALSE;
  183.     x := 40+xx*3;  dx := 42+xx*3; y := 30+yy*3;  dy := 32+yy*3
  184.    END
  185.   END
  186.  END
  187. END SegInit;
  188.  
  189. (* $E- *)
  190. PROCEDURE Colors;
  191. BEGIN
  192.  INLINE (0000H, 000FH, 010EH, 020DH, 030CH, 040BH, 050AH, 0609H,
  193.          0708H, 0807H, 0906H, 0A05H, 0B04H, 0C03H, 0D02H, 0E01H,
  194.          0F00H, 0F10H, 0F20H, 0F30H, 0F40H, 0F50H, 0F60H, 0F70H,
  195.          0F80H, 0F90H, 0FA0H, 0FB0H, 0FC0H, 0FD0H, 0FE0H, 0FF0H)
  196. END Colors;
  197.  
  198. PROCEDURE Cleanup;
  199. BEGIN
  200.  IF Level >= CurrentLevel() THEN
  201.   IF win#NIL THEN CloseWindow (win) END;
  202.   IF scr#NIL THEN CloseScreen (scr) END
  203.  END
  204. END Cleanup;
  205.  
  206. PROCEDURE InitSys;
  207. BEGIN
  208.  TermProcedure (Cleanup);  Level := CurrentLevel();
  209.  
  210.  scr := CreateScreen (WIDTH, HEIGHT, DEPTH, ViewModeSet{}, NIL, NIL);
  211.  win := CreateWindow (0,0, WIDTH, HEIGHT, IDCMPFlagSet{mouseButtons},
  212.                 WindowFlagSet{borderless, activate, rmbTrap, noCareRefresh},
  213.                 NIL, scr, NIL, customScreen);
  214.  vp := ADR (scr^.viewPort);
  215.  rp := ADR (scr^.rastPort);
  216.  LoadRGB4 (vp, ADR(Colors), 32);
  217. END InitSys;
  218.  
  219. VAR x, y : INTEGER;
  220. BEGIN           (* HauptProgramm *)
  221.  
  222.  InitSys;
  223.  FarbTest;
  224.  
  225.  SegInit;
  226.  FOR x:=0 TO MaxSeg DO
  227.   FOR y:=0 TO MaxSeg DO
  228.    Zeichne (x, y)
  229.   END
  230.  END;
  231.  
  232.  Process;
  233.  
  234.  WaitPort (win^.userPort);
  235.  
  236. END Therm.
  237.